
# here is a sample html viewer to demonstrate the library usage
# Copyright (c) 1995 by Sun Microsystems
# Additional modifications by Kevin Walzer, (c) 2006-2009 WordTech Communications LLC
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package provide tkwebview 1.0


#KW 2008: Let's initialize some variables. It would be preferable to use
#namespaces here, but the core code of this package is old and complex, and I'm
#afraid things will break if we convert global variables to namespace variables.
#We attempt to avoid namespace collisions by using standard prefixes, e.g.
#WebView_$var.

global WebView_Library

set WebView_Library [file join [file dirname [info script]]]
#puts $WebView_Library

source [file join $WebView_Library htmllib.tcl]


#first, utility routines from old htmllib code, with minor modifications as required--KW 2009

# Go render a page.  We have to make sure we don't render one page while
# still rendering the previous one.  If we get here from a recursive
# invocation of the event loop, cancel whatever we were rendering when
# we were called.
# If we have a fragment name, try to go there.

proc HMrender {file} {
    global HM.text HMurl HMlast WebView_ClickLink WebView_Library WebView WebView_Viewwindow


    #KW: configure text widget to read read/display page
    $WebView.text configure -state normal

    #KW: HMlast refers to list of previously viewed pages
    lappend HMlast $file

    #KW: configure "back button" to disabled; use "catch" for handling embedded view
    if {[llength $HMlast] <= 1} {
#	catch {$WebView.back configure  -state disabled }
# $WebView.back configure  -state disabled

 catch {$WebView_Viewwindow.frame.bottom.back configure -state disabled}

    } else {
	#KW: configure "back button" to normal; use "catch" for handling embedded view

	catch {$WebView_Viewwindow.frame.bottom.back configure -state normal}
    }

    set fragment ""
    regexp {([^#]*)#(.+)} $file dummy file fragment
    if {$file == "" && $fragment != ""} {
	HMgoto $WebView.text $fragment
	return
    }

    HMreset_win $WebView.text
    update idletasks
    if {$fragment != ""} {
	HMgoto $WebView.text $fragment
    }
    set HMurl $file
    HMparse_html [HMget_html $file] {HMbaserender $WebView.text}

    HMset_state $WebView.text -stop 1	;# stop rendering previous page if busy


    #reset text widget to disabled--prevents user from editing text in help display
    $WebView.text configure -state disabled
}

#load previous page
proc HMrenderlast {} {

    #KW: procedure courtesy of Bruce Johnson, http://www.onemoonscientific.com/

    global WebView WebView_ClickLink WebView_Library WebView_Viewwindow
    global HMlast

    set len [llength $HMlast]
    set HMnewurl [lindex $HMlast [expr $len-2]]
    set HMlast [lrange $HMlast 0 [expr $len-3]]


    HMrender $HMnewurl

}


#set the home page for the viewer
proc HMsetHome {file} {

global HMhome WebView WebView_ClickLink WebView_Library WebView_Viewwindow

set HMhome $file
return $HMhome

}

#return home
proc HMgohome {} {
    global HMhome WebView WebView_ClickLink WebView_Library WebView_Viewwindow
    HMrender $HMhome
}

# given a file name, return its html, or invent some html if the file can't
# be opened.

proc HMget_html {file} {
    global HMhome WebView WebView_ClickLink WebView_Library WebView_Viewwindow

    if {[catch {set fd [open $file]} msg]} {
	return "
			<title>Bad file $file</title>
			<h1>Error reading $file</h1><p>
			$msg<hr>
		       	       "
    }

    set result [read $fd]
    close $fd
    return $result
}

# Override the library link-callback routine for the sample app.
# It only handles the simple cases.

proc HMlink_callback {win href} {

    global WebView WebView_ClickLink HMurl WebView_Library WebView_Viewwindow

    set WebView_ClickLink $href

    $WebView.text configure -cursor hand2

    #KW 2008: generate virtual events for various kinds of clicks

    #http://
    if {[string match {http:*} $href]} {

       	event generate $WebView <<HTTPClick>>
	bind <<HTTPClick>> [WebView_HTTP  $WebView_ClickLink]
	$WebView.text configure -cursor arrow
	return
    }

    #https://
    if {[string match {https:*} $href]} {
	event generate $WebView <<HTTPClick>>
	bind <<HTTPClick>> [WebView_HTTPS  $WebView_ClickLink]
	$WebView.text configure -cursor arrow
	return
    }

    #ftp://
    if {[string match {ftp:*} $href]} {
	event generate $WebView <<FTPClick>>
	bind <<FTPClick>> [WebView_FTP $WebView_ClickLink]
	$WebView.text configure -cursor arrow
	return
    }


    #sftp://
    if {[string match {sftp:*} $href]} {
	event generate $WebView <<SFTPClick>>
	bind <<FTPClick>> [WebView_SFTP $WebView_ClickLink]
	$WebView.text configure -cursor arrow
	return
    }

    #mailto:
    if {[string match {mailto:*} $href]} {
	event generate $WebView <<MailClick>>
	bind <<MailClick>>  [WebView_Mailto $WebView_ClickLink]

	$WebView.text configure -cursor arrow
	return
    }


    #local files
    if {[string match #* $href]} {
	HMrender $href
	$WebView.text configure -cursor arrow
	return
    }
    if {[string match /* $href]} {
	set HMurl $href
    } else {
	set HMurl [file dirname $HMurl]/$href
    }
    update
    HMrender $HMurl
    $WebView.text configure -cursor arrow
}


##procedures to handle external links when corresponding virtual event fires--KW 2008

#http://
proc WebView_HTTP {link} {
    global WebView_ClickLink WebView_Library WebView WebView_Viewwindow

}

#https://
proc WebView_HTTPS {link} {
    global WebView_ClickLink WebView_Library WebView WebView_Viewwindow

}

#ftp://
proc WebView_FTP {link} {
    global WebView_ClickLink WebView_Library WebView WebView_Viewwindow

}

#sftp://
proc WebView_SFTP {link} {
    global WebView_ClickLink WebView WebView_Library WebView_Viewwindow

}

#mailto:
proc WebView_Mailto {link} {
    global WebView_ClickLink WebView_Library WebView WebView_Viewwindow

}

# Handle base tags.  This breaks if more than 1 base tag is in the document

proc HMtag_base {win param text} {
    global HMurl WebView WebView_ClickLink WebView_Library WebView_Viewwindow
    upvar #0 HM$win var
    HMextract_param $param href HMurl
}

# downloading fonts can take a long time.  We'll override the default
# font-setting routine to permit better user feedback on fonts.  We'll
# keep our own list of installed fonts on the side, to guess when delays
# are likely

proc HMset_font {win tag font} {
    global  Fonts WebView_ClickLink WebView_Library WebView_Viewwindow
    if {![info exists Fonts($font)]} {
	set Fonts($font) 1
	#.msg configure -fg blue
	set message "downloading font $font"
	update
    }

    set message ""
    catch {$win tag configure $tag -font $font} message
}

# Lets invent a new HTML tag, just for fun.
# Change the color of the text. Use html tags of the form:
# <color value=blue> ... </color>
# We can invent a new tag for the display stack.  If it starts with "T"
# it will automatically get mapped directly to a text widget tag.

proc HMtag_color {win param text} {
    upvar #0 HM$win var
    set value bad_color
    HMextract_param $param value
    $win tag configure $value -foreground $value
    HMstack $win "" "Tcolor $value"
}

proc HMtag_/color {win param text} {
    upvar #0 HM$win var
    HMstack $win / "Tcolor {}"
}

# Add a font size manipulation primitive, so we can use this sample program
# for on-line presentations.  sizes prefixed with + or - are relative.
#  <font size=[+-]3>  ..... </font>.  Note that this is not the same as
# Netscape's <font> tag.

proc HMtag_font {win param text} {
    upvar #0 HM$win var
    set size 0; set sign ""
    HMextract_param $param size
    regexp {([+-])? *([0-9]+)} $size dummy sign size
    if {$sign != ""} {
	set size [expr [lindex $var(size) end] $sign $size]
    }
    HMstack $win {} "size $size"
}

# This version is closer to what Netscape does

proc HMtag_font {win param text} {
    upvar #0 HM$win var
    set size 0; set sign ""
    HMextract_param $param size
    regexp {([+-])? *([0-9]+)} $size dummy sign size
    if {$sign != ""} {
	set size [expr [lindex $var(size) end] $sign  $size*2]
	HMstack $win {} "size $size"
    } else {
	HMstack $win {} "size [expr 10 + 2 * $size]"
    }
}

proc HMtag_/font {win param text} {
    upvar #0 HM$win var
    HMstack $win / "size {}"
}


##now let's begin building the various HTML widget views--KW

#base HTML viewer that can be embedded in other widgets or in toplevel
proc WebView_View {parent} {

    global WebView WebView_ClickLink WebView_Library

    set WebView [ttk::frame $parent.webview]

    pack $WebView -fill both -expand yes


    ttk::scrollbar $WebView.scrollbar  -command "$WebView.text yview"  -orient vertical

    option add *Text.height 40 startup
    option add *Text.width 80 startup

    text $WebView.text  -yscrollcommand "$WebView.scrollbar set" -padx 3 -pady 3 -takefocus 0 -borderwidth 0 -highlightthickness .5 -bg white
    $WebView.text configure -cursor arrow

    pack $WebView.scrollbar -side right -expand 0 -fill y
    pack $WebView.text -side left -fill both -expand 1


    bind $WebView <End> {$WebView.text yview end}
    bind $WebView <Home> {$WebView.text yview 0.0}
    bind $WebView <Next> {$WebView.text yview scroll 1 page}
    bind $WebView <Prior> {$WebView.text yview scroll -1 page}

}

#WebView embedded in toplevel window
proc WebView_Standalone {} {

    global WebView HMhome WebView_ClickLink WebView_Library WebView_Viewwindow


    set WebView_Viewwindow [toplevel .standalone]

    ttk::frame $WebView_Viewwindow.frame
    pack $WebView_Viewwindow.frame -fill both -expand yes

    ttk::frame $WebView_Viewwindow.frame.top
    pack $WebView_Viewwindow.frame.top -side top -fill both -expand yes

    WebView_View $WebView_Viewwindow.frame.top


    ttk::frame $WebView_Viewwindow.frame.bottom -padding 3
    pack $WebView_Viewwindow.frame.bottom -fill both -side bottom -expand yes


    ttk::button $WebView_Viewwindow.frame.bottom.quit   -text Dismiss -command {destroy .standalone}
    ttk::button  $WebView_Viewwindow.frame.bottom.back  -text "Back" -command HMrenderlast
    ttk::button  $WebView_Viewwindow.frame.bottom.home -text Home -command HMgohome

    pack $WebView_Viewwindow.frame.bottom.home $WebView_Viewwindow.frame.bottom.back $WebView_Viewwindow.frame.bottom.quit -side left

    ttk::separator $WebView_Viewwindow.frame.s -orient vertical
    pack $WebView_Viewwindow.frame.s -fill both -expand no -side bottom

}


#finally, let's add the HTML to the widget
proc WebView_Standalonewidget {title file} {

  global WebView HMhome WebView_ClickLink WebView_Library WebView_Viewwindow

    set HMhome $file

    WebView_Standalone
    wm title [winfo toplevel $WebView] $title
    set HMsize -1
    set HMindent 1
    HMinit_win $WebView.text
    HMset_state $WebView.text -size $HMsize
    HMset_indent $WebView.text $HMindent
    HMrender $HMhome

}


#this embeds the webview in arbitrary widget
proc WebView_Embedded {w} {

    global WebView HMhome WebView_ClickLink WebView_Viewwindow WebView_Library

    set mytitle [wm title .]

    WebView_View $w

    wm title . $mytitle

}


#finally, with the embedded view built, we load it and add the HTML rendering routines
proc WebView_Embeddedwidget {w file} {

    global WebView HMHome WebView_ClickLink WebView_Library WebView_Viewwindow

    WebView_Embedded $w

    set HMhome $file
    set HMsize -1
    set HMindent 1
    HMinit_win $WebView.text
    HMset_state $WebView.text -size $HMsize
    HMset_indent $WebView.text $HMindent
    HMrender $HMhome

}

###here are some demos and utility functions

#demo of standalone
proc WebView_Standalonedemo {} {

    global WebView HMhome WebView_ClickLink WebView_Library WebView_Viewwindow

    set HMhome [file join $WebView_Library help.html]

    WebView_Standalonewidget "TkWebView Demo" $HMhome

}

#here is a specialized standalone with "Help" as the title
proc WebView_Helpviewer {file} {

    global WebView HMhome WebView_ClickLink WebView_Library WebView_Viewwindow

    set HMhome $file

    WebView_Standalonewidget "Help" $file
}

#here is a demo of the embedded widget
proc WebView_Embeddeddemo {} {

    global WebView HMHome WebView_ClickLink WebView_Library WebView_Viewwindow

    toplevel .t

    pack [listbox .t.l] -side left -fill both -expand yes

    foreach item {a b c} {
	.t.l insert end $item
    }

    set widget [ttk::frame .t.f]

    pack $widget -side right -fill both -expand yes

    set HMhome [file join $WebView_Library help.html]

    WebView_Embeddedwidget $widget $HMhome
    wm title [winfo toplevel $WebView] "TkWebView Embedded Widget Demo"

}
